home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / C / OUTPUT.C < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-24  |  3.5 KB  |  129 lines
  1. /* OUTPUT.C
  2.  ************************************************************************
  3.  *                                    *
  4.  *        PC Scheme/Geneva 4.00 Borland C code            *
  5.  *                                    *
  6.  * (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7.  * (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8.  *                                    *
  9.  *----------------------------------------------------------------------*
  10.  *                                    *
  11.  *              PC-Scheme port output routines            *
  12.  *                                    *
  13.  *----------------------------------------------------------------------*
  14.  *                                    *
  15.  * Created by: Marc Vuilleumier        Date: Jan 1993            *
  16.  *             (clear_window & gc's written by John Jensen Feb 1985)    *
  17.  * Revision history:                            *
  18.  * - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  19.  *                                    *
  20.  *                    ``In nomine omnipotentii dei''    *
  21.  ************************************************************************/
  22.  
  23. #include    <string.h>
  24. #include    <stdlib.h>
  25. #include    <stdio.h>
  26. #include    <alloc.h>
  27. #include    <dos.h>
  28. #include    "scheme.h"
  29.  
  30. /************************************************************************/
  31. /* Clear Window                                */
  32. /************************************************************************/
  33. int    clear_window(REGPTR reg)
  34. {
  35.     PORT    far    *p;
  36.  
  37.     if( get_port(reg, INPUT_PORT) )
  38.     {
  39.         set_src_error("WINDOW-CLEAR", 1, reg);
  40.         return    -1;
  41.     }
  42.     p = ®2c(&tmp_reg)->port;
  43.  
  44.     if( ptype[CORRPAGE(tmp_reg.page)] != PORTTYPE ||
  45.         (p->flags & PORT_TYPE) != TYPE_WINDOW )
  46.     {
  47.         set_src_error("WINDOW-CLEAR", 1, reg);
  48.         return    -1;
  49.     }
  50.  
  51.     zclear( p->ulline, p->ulcol, p->nlines, p->ncols, p->text );
  52.  
  53.     if( p->border != 0xffff )
  54.     {
  55.         char    *string;
  56.  
  57.         load( &tmp_reg, &(p->ptr) );
  58.         string = string_asciz(&tmp_reg);
  59.         zborder( p->ulline, p->ulcol, p->nlines, p->ncols, p->border, string);
  60.         rlsstr(string);
  61.     }
  62.     p->curline = p->curcol = 0;
  63.     return    0;
  64. }
  65.  
  66. /************************************************************************/
  67. /* Write "GC On" Message to the who-line                */
  68. /************************************************************************/
  69. void     gc_on(int squishing)
  70. {
  71.     REG    lcl_reg;
  72.     char    *text;
  73.  
  74.     intern(&lcl_reg, "PCS-GC-MESSAGE", 14);
  75.     if( sym_lookup(&lcl_reg, &gnv_reg) && (text = string_asciz(&lcl_reg)) != 0)
  76.     {
  77.         who_write("\n");
  78.         who_write(text);
  79.         rlsstr(text);
  80.     } else {
  81.         if( squishing )
  82.             who_write("\n * Garbage Squishing *");
  83.         else
  84.             who_write("\n * Garbage Collecting *");
  85.     }
  86. }
  87.  
  88. /************************************************************************/
  89. /* Un-Write "GC On" Message to the who-line                */
  90. /************************************************************************/
  91. void     gc_off(void)
  92. {
  93.     REG        lcl_reg;
  94.     char        *text, s[255];
  95.     int        dynamic = 0;
  96.  
  97.     internimm( &lcl_reg, "PCS-GC-RESET");
  98.     if ( !sym_lookup(&lcl_reg, &gnv_reg) )
  99.         lcl_reg = nil_reg;
  100.  
  101.     if ( (text = string_asciz(&lcl_reg)) == NULL )
  102.         text = VERSIONSTR " [Free: scheme=%lu\b\b\bKb, kernel=%lu\b\b\bKb]";
  103.     else
  104.         dynamic = 1;
  105.  
  106.     sprintf( s, text, (long) freesp(), (long) coreleft() );
  107.     who_write("\n");
  108.     who_write( s );
  109.  
  110.     if( dynamic )
  111.         rlsstr(text);
  112. }
  113.  
  114.  
  115. /************************************************************************/
  116. /* Write a message to the who-line                    */
  117. /************************************************************************/
  118. void    who_write( char *text )
  119. {
  120.     REG        oldport = port_reg;
  121.  
  122.     ssetadr( ADJPAGE(WHO_PAGE), WHO_DISP );
  123.     printstr( text, strlen(text) );
  124.  
  125.     if ( ptype[CORRPAGE(oldport.page)] == PORTTYPE )
  126.         ssetadr( oldport.page, oldport.disp );
  127. }
  128.  
  129.